home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / jed096_1.zip / SLANG / SRC / CALC.SL < prev    next >
Text File  |  1994-04-26  |  4KB  |  199 lines
  1. % calc.sl--- Init file for calc.  This file must be placed in the default
  2. %  directory for calc and is automatically loaded when calc runs.
  3. %
  4. % This file contains S-Lang code for Newton's method, etc...
  5. %
  6. % Here is a function which computes the root of the equation y = f(x) using
  7. % Newtons method.  The usage is:
  8. %  
  9. %   root = newton(s, &f);
  10. %
  11. % where s is a seed value and f is the function whose root is sought.
  12. %
  13. % For example, consider the function my_fun(x) = x^2 - 2 with solution 
  14. % x = sqrt(2).  This function may be expressed in S-Lang as:
  15. %
  16. % define my_func(x)
  17. % {
  18. %   return (x * x - 2);
  19. % }
  20. %    
  21. % To solve the equation my_fun(x) = 0 using the newton routine below, use
  22. %
  23. %     newton(5.0, &myfun);
  24. %
  25. % Here, I have randomly chosen 5.0 as an initial guess.   In addition,
  26. % I have used the '&' operator to pass the function 'myfun' to the routine.
  27.  
  28.  
  29. % Newton's method requires the derivative of a function.  Here is such a 
  30. % function called by newton.  Given f(x), it returns df/dx at the point x.
  31. %
  32. % Its usage is:
  33. %  
  34. %    derivative(x, &f);
  35.  
  36. define derivative(x, f)
  37. {
  38.    variable dx;
  39.    dx = 1.0e-4;        % small number
  40.   
  41.    return ((f(x + dx) - f(x - dx))/(2 * dx));
  42. }
  43.  
  44. % And now the Newton's method:
  45.  
  46. define newton(x, f)
  47. {
  48.    variable err, max, dx;
  49.    
  50.    err = 1.0e-6;
  51.    max = 1000;
  52.    
  53.    while (max)
  54.      {
  55.     --max;
  56.     dx = f(x) / derivative(x, &f);
  57.     if (abs(dx) < err)
  58.       {
  59.          return(x);
  60.       }
  61.     
  62.     x = x - dx;
  63.      } 
  64.    
  65.    print ("\7Root not found.  Try another seed!\n");
  66.    return(x);
  67. }
  68.  
  69.    
  70.    
  71. %% This is a standard benchmark for interpreters.  It is a heavily
  72. %% recursive routine that returns the nth Fibonacci number.  
  73. %% It is defined recursively as:
  74. %%
  75. %%     f_0 = 0, f_1 = 1, .... , f_{n+1} = f_n + f_{n-1}, ...
  76. %%
  77. %%     or {0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, ...}
  78. %%
  79.  
  80. define fib();               % required for recursion 
  81.  
  82. define fib(n)
  83. {
  84.    !if (n) return(0);
  85.    --n;
  86.    !if (n) return(1);
  87.   
  88.    fib(n) + fib( --n, n);   %Note that this expression parses to RPN
  89.                             %  n fib --n n fib +
  90.                 %and since --n does not change the stack, the
  91.                 %effect is the same as the C comma operator.
  92. }
  93.  
  94. % a print function
  95. define p(obj)
  96. {
  97.    print(string(obj));
  98.    print("\n");
  99. }
  100.  
  101. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  102. %   Two routines which illustrate the how to deal with files
  103. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  104.  
  105. % type out a file to terminal
  106. define type_file(file)
  107. {
  108.    variable fp, n;
  109.    
  110.    fp = fopen(file, "r");
  111.    if (fp == -1)
  112.      {
  113.     print("\7File could not be opened!\n");
  114.     return;
  115.      }
  116.    
  117.    while (fgets(fp) > 0)
  118.      {
  119.     print(());     % characters on the stack so print them
  120.      }
  121.    
  122.    !if (fclose(fp)) 
  123.      {
  124.     print("\7Error closing file!\n");
  125.      }   
  126. }
  127.  
  128.  
  129. %
  130. %  Here is a function that prints the number of lines in a file
  131. %
  132.  
  133. define count_lines(f)
  134. {
  135.    variable fp, n, nchars, dn;
  136.    
  137.    fp = fopen(f, "r");
  138.    if (fp < 0) error("Unable to open file!");
  139.    n = 0; nchars = 0;
  140.    
  141.    while (dn = fgets(fp), dn > 0)
  142.      {
  143.     pop();     %/* do not care about the characters themselves! */
  144.     ++n;
  145.     nchars += dn;
  146.      }
  147.    fclose(fp); pop();               %/* ignore return value */
  148.    
  149.    print(Sprintf("File consists of %d characters and %d lines.\n",
  150.          nchars, n, 2));
  151. }
  152.  
  153.  
  154. % an apropos function
  155. define apropos (what)
  156. {
  157.    variable n = slapropos(what);
  158.    variable i, f1, f2, f3;
  159.  
  160.    if (n) print (Sprintf("found %d matches:\n", n, 1));
  161.    else
  162.      {
  163.     print ("No matches.\n");
  164.     return;
  165.      }
  166.    
  167.    loop (n / 3) 
  168.      {
  169.     =f1; =f2; =f3;
  170.     print (Sprintf("%-26s %-26s %s\n", f1, f2, f3, 3));
  171.      }
  172.    n = n mod 3;
  173.    loop (n)
  174.      {
  175.     =f1;
  176.     print (Sprintf("%-26s ", f1, 1));
  177.      }
  178.    if (n) print("\n");
  179. }
  180.  
  181. %
  182. #ifdef 0
  183. _for (0, 99, 1) 
  184. {
  185.    =$1;
  186.    Writable_array[$1] = $1;
  187. }
  188.  
  189. _for (0, 99, 1) 
  190. {
  191.    =$1;
  192.    p (Sprintf("Writable_array[$%d]\t=%d", $1, Writable_array[$1], 2));
  193. }
  194. #endif
  195.  
  196. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  
  197. %    end of calc.sl     
  198. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  199.